home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The X-Philes (2nd Revision)
/
The X-Philes Number 1 (1995).iso
/
xphiles
/
hp48_2
/
roman_jg
< prev
next >
Wrap
Internet Message Format
|
1995-03-31
|
9KB
From: James Gentles <jdg@hpqtdla.sqf.hp.com>
Subject: v04i023: roman_jg - Roman Numerals v1.0, Part01/01
Newsgroups: comp.sources.hp48
Followup-To: comp.sys.hp48
Approved: spell@seq.uncwil.edu
Checksum: 393391880 (verify with brik -cv)
Submitted-by: James Gentles <jdg@hpqtdla.sqf.hp.com>
Posting-number: Volume 4, Issue 23
Archive-name: roman_jg/part01
------------------------------------------------------------------------
I have no professional connection with Hewlett-Packard's
calculator operations other than as a user of their products.
------------------------------------------------------------------------
Opinions expressed are my own, and are not intended to be an official
statement by Hewlett-Packard Company/Limited
------------------------------------------------------------------------
"To strive, to seek, to find, and not to yield." Ulysses, Tennyson.
------------------------------------------------------------------------
James Gentles Hewlett Packard, Amateur: GM4WZP
Queensferry Telecoms Division QTD, Email: jdg@hpsqf.sqf.hp.com
Station Road, South Queensferry, HPDESK: James Gentles / HP1400
West Lothian, Scotland, EH30 9XR. Phone: +44 31 331 7663, FAX: ~7488
------------------------------------------------------------------------
BEGIN_DOC roman.doc
ROMAN NUMERAL CONVERSION ROUTINES FOR THE HP48 15Mar92
The following two routines translate between integers and roman numerals.
The Roman system uses 7 letters to represent different weightings:
M 1000
D 500
C 100
L 50
X 10
V 5
I 1
These are assembled additively into a string, largest numbers being left
justified:
e.g. "MCL" is 1150
In addition any character may be preceeded by one of the following:
C 100
X 10
I 1
and this is subtracted from the character. So 9 is "IX" and NOT "VIIII"
However "IM" is not allowed for 999. The preceeding character must be
the next least significant of the ones listed above, e.g. "CMXCIX" for 999.
Only one preceeding character is allowed at a time, 8 is NOT "IIX" it should
be represented by "VIII".
Finally a whole expression can be multiplied by 1000 if a bar covers it.
This aspect is not reproduced in the following programs.
->RN: Takes a number from the stack and returns a string containing the
roman numeral. The result is "tagged" with the original number from
the stack. If the stack is empty then a message indicating the
correct syntax for the routine is returned. If the number has a
fractional part then the fraction is ignored. If the number is greater
than 10000 then only the part of the number <10000 is processed, the
resulting string is preceeded with a "+" to indicate this. This
prevents the creation of very long roman numerals with dozens of
preceeding "M"'s, that take ages to process.
RN->: Takes a string from the stack and returns the equivalent integer.
The result is "tagged" with the original string from the stack.
If the stack is empty then a message indicating the correct syntax
for the routine is returned. If the string contains characters other
than "MDCLXVI" then the program fails. The routine will translate all
legal roman numerals, it will also translate some non legal ones:
e.g. "VX" (5) "MIM" (1999), however it will not translate "IIV"
correctly.
END_DOC
HP48 ASCII CODE for \->RN.....................................................
BEGIN_RPL torn.rpl
%%HP: T(3)A(D)F(.);
\<< DEPTH
IF THEN IP "MDCLXVI" "CCXXII " { 1000 500 @ Create four lists that
100 50 10 5 1 } { 100 100 10 10 1 1 0 } @ define the translation
\-> r rs w ws
\<< DUP DUP 10000 >
IF THEN 10000 MOD "+" @ If greater than 10000 then
ELSE "" @ truncate input and add "+"
END
1 r SIZE FOR i @ For each character in the
r i i SUB rs i i SUB w i GET ws i GET@ translation get the weighting
\-> r1 r2 w1 w2 @ from the list
\<<
WHILE OVER w1 \>=
REPEAT SWAP w1 - SWAP r1 + @ subtract weighting as
END @ many times as possible.
IF OVER w2 + w1 \>= @ Check if one more can be
THEN SWAP w1 - w2 + SWAP r2 + r1 + @ subtracted with preceeding
END @ character.
\>>
NEXT
\>> SWAP DROP SWAP \->TAG @ Tag output with input integer
ELSE
"INT \-> Roman Numeral $" @ Print this string as help
DOERR
END
\>>
END_RPL
HP48 ASCII CODE for RN\->.....................................................
BEGIN_RPL fromrn.rpl
%%HP: T(3)A(D)F(.);
\<< DEPTH IF
THEN EVAL DUP SIZE "IVXLCDM" { 1 5 10 @ Create two lists for
50 100 500 1000 } \-> s l r w @ the translation
\<< { }
1 l FOR i @ for each character in the input
s i i SUB r SWAP POS w SWAP GET + @ build a list of the weights
NEXT 0 + l \-> v l
\<< 0 1 l FOR i @ For the list of weights
v i GET DUP v i 1 + GET < @ subtract if followed by a
IF THEN - ELSE + END @ larger number else add
NEXT s \->TAG @ Tag output with input string
\>>
\>>
ELSE
"Roman Numeral $ \-> INT" @ Print this string as help
DOERR
END
\>>
END_RPL
[Note: I created a diectory and put the two programs in there.
So the asc'ed & uuencoded versions should have the correct file
names in the 48. -cgs ]
BEGIN_ASC roman.asc
%%HP: T(3)A(D)F(.);
"69A20FF78A200000003025E4D830D9D20E163244CF13CE22AFE22D9D20EB3A17
8BF18B9C1C2A2031000946585C43444D447A209C2A2D13A23392010000000000
0001033920100000000000005033920200000000000001033920200000000000
0050339203000000000000010B21301C432D6E201037D6E2010C6D6E201027D6
E201077E163247A20B21309C2A2D6E2010C60A132D6E201096D6E201037D6E20
1096D6E201096C58C1D6E201027DBBF14BAC1D6E201077DBBF16C7D176BA1C42
324B2A276BA1D6E2010C61C432D6E201067D6E2010C6E16324B2A29C2A2D6E20
10C60A132D6E201096D6E201067D6E2010966C7D178BF1D6E201067D6E201096
9C2A276BA16C7D1EBBE13CE22AFE2290DA15BF2276BA15DF22C4232D6E201037
EB522EF532EF532B21305BF22D9D20C2A20F200025F6D616E602E457D6562716
C6024202D80294E445933A1B21305DF2293632B21309920030D825E430D9D20E
163244CF13CE22AFE22D9D20D6BB1C2A2031000D44434C4856594C2A20310003
434858594940247A203392030000000000000103392020000000000000503392
02000000000000010339201000000000000050339201000000000000010D13A2
9C2A2B213047A203392020000000000000103392020000000000000103392010
000000000000103392010000000000000109C2A29C2A24B2A2B21301C432D6E2
01027D6E20202737D6E201077D6E20207737E163278BF178BF13392040000000
00000010D5CE13CE22AFE22D9D20339204000000000000010D4EB1C2A2070000
B2B21305BF22C2A20500005DF229C2A2D6E2010278B9C10A132D6E201096D6E2
01027D6E201096D6E201096C58C1D6E20202737D6E201096D6E201096C58C1D6
E201077D6E2010966C7D1D6E20207737D6E2010966C7D11C432D6E20202713D6
E20202723D6E20207713D6E20207723E16323303292CF1D6E20207713B9DE1D5
032D9D20DBBF1D6E2020771390DA1DBBF1D6E2020271376BA1B2130496323CE2
292CF1D6E2020772376BA1D6E20207713B9DE1AFE22D9D20DBBF1D6E20207713
90DA1D6E2020772376BA1DBBF1D6E2020272376BA1D6E2020271376BA1B21305
DF22EF532C4232EF532DBBF18DBF1DBBF1EB522B21305BF22D9D20C2A20F2000
94E44502D80225F6D616E602E457D6562716C60242933A1B21305DF2293632B2
13001CF"
END_ASC
BYTES: #FC10h 875
BEGIN_UU roman.uue
begin 644 roman
M2%!(4#0X+466*O!_J`(````#4DZ-`YTMX&$C1/PQ["+Z+M+9`KZC<;@?N,G!
MH@(3`)!DA<4T1-1$IP+)HM(Q*C,I$````````!`PDP(!````````!3,I(```
M`````!`PDP("````````!3,I,````````!"P$@/!--+F`@%S;2X0P-;F`@%R
M;2X0<.=A(W0JL!(#R:+2Y@(!;*`QTN8"`6EM+A`PU^8"`6EM+A"0QH4<;2X0
M(->['[3*T>8"`7>]^V%\'6>KP20CM*)RMAIM+A#`%DPC;2X08-?F`@%L'C9"
M*RK)HM+F`@%LH#'2Y@(!:6TN$Y@(!:<;7<;@?;2X08-?F`@%IR:)RMAK&
MU^&['L,NHN\B":U1^R)GJU'](DPRTN8"`7.^)>)?(_XULA(#M2_2V0(L*O`"
M`%)O;6%N($YU;65R86P@)""-($E.5#FCL1(#U2^28R,K,9`I``.-4DX#G2W@
M82-$_#'L(OHNTMD";;O!H@(3`-!$-,2$997$H@(3`#`TA(65E`1"IP(S*3``
M```````0,),"`@````````4S*2`````````0,),"`0````````4S*1``````
M```0T#$JR:*R$@-T*C"3`@(````````!,RD@````````$#"3`@$````````!
M,RD0````````$)`L*LFB0BLJ*S$03"-M+A`@U^8"`G)S;2X0<-?F`@)W<QXV
M<K@?A_LQDP($`````````5WL,>PB^B[2V0(S*4`````````0T.0;+"IP```K
M*S%0^R(L*E```-4ODBPJ;2X0((>;'*`QTN8"`6EM+A`@U^8"`6EM+A"0QH4<
M;2X@(#?7Y@(!:6TN$)#&A1QM+A!PU^8"`6G&U]'F`@)W<VTN$)!F?!W!--+F
M`@)R,6TN("`GT^8"`G<Q;2X@<"?C82,S,)+"'VTN('`7L]D>73#2V0*]^]'F
M`@)W,0FMT;L?;2X@(!=SMAHK,4!I(\,NDL(?;2X@<"=SMAIM+B!P%[/9'OHN
MTMD"O?O1Y@("=S$)K='F`@)W,F>KT;L?;2X@("=SMAIM+B`@%W.V&BLQ4/TB
M_C7")"/^-=*[']C[T;L?OB6R$@.U+]+9`BPJ\`(`24Y4((T@4F]M86X@3G5M
397)A;"`D.:.Q$@/5+Y)C(RLQ`"LQ
`
end
END_UU